home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
COMPILER
/
LYSRC
/
YACCMSGS.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-01-23
|
5KB
|
152 lines
unit YaccMsgs;
(* 2-5-91 AG *)
(* Copyright (c) 1990,91 by Albert Graef, Schillerstr. 18,
6509 Schornsheim/Germany
All rights reserved *)
interface
(* TP Yacc message and error handling module 2-5-91 AG
Note: this module should be USEd by any module using the heap during
initialization, since it installs a heap error handler (which
terminates the program with fatal error `memory overflow'). *)
var errors, warnings : Integer;
(* - current error and warning count *)
procedure error(msg : String);
(* - print current input line and error message (pos denotes position to
mark in source file line) *)
procedure warning(msg : String);
(* - print warning message *)
procedure fatal(msg : String);
(* - writes a fatal error message, erases Yacc output file and terminates
the program with errorlevel 1 *)
const
(* sign-on and usage message: *)
sign_on = 'TP Yacc Version 3.0a [May 92], Copyright (c) 1990-92 Albert Graef';
usage = 'Usage: YACC [options] yacc-file[.Y] [output-file[.PAS]]';
options = 'Options: /v verbose, /d debug';
(* command line error messages: *)
invalid_option = 'invalid option ';
illegal_no_args = 'illegal number of parameters';
(* syntax errors: *)
open_comment_at_eof = '101: open comment at end of file';
missing_string_terminator = '102: missing string terminator';
rcurl_expected = '103: %} expected';
rbrace_expected = '104: } expected';
rangle_expected = '105: > expected';
ident_expected = '106: identifier expected';
error_in_def = '110: error in definition';
error_in_rule = '111: error in rule';
syntax_error = '112: syntax error';
unexpected_eof = '113: unexpected end of file';
(* semantic errors: *)
nonterm_expected = '201: nonterminal expected';
literal_expected = '202: literal expected';
double_tokennum_def = '203: literal already defined';
unknown_identifier = '204: unknown identifier';
type_error = '205: type error';
range_error = '206: range error';
empty_grammar = '207: empty grammar?';
(* fatal errors: *)
cannot_open_file = 'FATAL: cannot open file ';
write_error = 'FATAL: write error';
mem_overflow = 'FATAL: memory overflow';
intset_overflow = 'FATAL: integer set overflow';
sym_table_overflow = 'FATAL: symbol table overflow';
nt_table_overflow = 'FATAL: nonterminal table overflow';
lit_table_overflow = 'FATAL: literal table overflow';
type_table_overflow = 'FATAL: type table overflow';
prec_table_overflow = 'FATAL: precedence table overflow';
rule_table_overflow = 'FATAL: rule table overflow';
state_table_overflow = 'FATAL: state table overflow';
item_table_overflow = 'FATAL: item table overflow';
trans_table_overflow = 'FATAL: transition table overflow';
redn_table_overflow = 'FATAL: reduction table overflow';
implementation
uses YaccBase;
procedure position(var f : Text;
lineNo : integer;
line : String;
pos : integer);
(* writes a position mark of the form
lineno: line
^
on f with the caret ^ positioned at pos in line
a subsequent write starts at the next line, indented with tab *)
var
line1, line2 : String;
begin
(* this hack handles tab characters in line: *)
line1 := intStr(lineNo)+': '+line;
line2 := blankStr(intStr(lineNo)+': '+copy(line, 1, pos-1));
writeln(f, line1);
writeln(f, line2, '^');
write(f, tab)
end(*position*);
procedure error(msg : String);
begin
inc(errors);
writeln;
position(output, lno, line, cno-tokleng);
writeln(msg);
writeln(yylst);
position(yylst, lno, line, cno-tokleng);
writeln(yylst, msg);
if ioresult<>0 then ;
end(*error*);
procedure warning(msg : String);
begin
inc(warnings);
writeln;
position(output, lno, line, cno-tokleng);
writeln(msg);
writeln(yylst);
position(yylst, lno, line, cno-tokleng);
writeln(yylst, msg);
if ioresult<>0 then ;
end(*warning*);
procedure fatal(msg : String);
begin
writeln;
writeln(msg);
close(yyin); close(yyout); close(yylst); erase(yyout);
halt(1)
end(*fatal*);
{$F+}
function heapErrorHandler ( size : Word ) : Integer;
{$F-}
begin
if size>0 then
fatal(mem_overflow) (* never returns *)
else
heapErrorHandler := 1
end(*heapErrorHandler*);
begin
errors := 0; warnings := 0;
(* install heap error handler: *)
heapError := @heapErrorHandler;
end(*YaccMsgs*).